functor Aux4Mir (A : AUX4MIR_STRUCTS) : AUX4MIR = 
struct
  open A
  structure M = Mir

  datatype mir_bk 
    = M_BK of string * string * (M.mir_lnode list)

  fun ck_mtch mirlist = 
      let val mirlist' = List.rev(mirlist)
	  fun ck ((M.Label(lb, _))::[]) = raise Fail "success!\n"
	    | ck ((M.Label(lb, _))::r) = 
	      let val t = List.hd(r)
	      in case t
		  of (M.JMP(lb)) => ck r
		   | (M.CJMP(_)) => ck r
		   | _ => raise Fail "fail\n"
	      end
	    | ck (l::r) = ck r
	    | ck [] = ()
      in ck mirlist'
      end
  
  fun exit_lb (M.JMP(lb)) = lb
    | exit_lb (M.CJMP(cop, e1, e2, tlb, flb)) = 
      (fn M.NE => tlb
	| _ => flb) cop
    | exit_lb _ = raise Fail "bug\n"

  fun bd_bk' (M.Label(lb, lbi), (c_bk, ex_lb, bks)) = 
      let val n_bks = M_BK(lb, ex_lb, (M.Label(lb, lbi)::c_bk))::bks
      in ([], "", n_bks)
      end
    | bd_bk' (M.JMP(lb), (c_bk, ex_lb, bks)) = 
      (M.JMP(lb)::c_bk, lb, bks)
    | bd_bk' (M.CJMP(cop, e1, e2, tlb, flb), (c_bk, ex_lb, bks)) = 
      let val e_lb = exit_lb (M.CJMP(cop, e1, e2, tlb, flb))
      in (M.CJMP(cop, e1, e2, tlb, flb)::c_bk, e_lb, bks)
      end
    | bd_bk' (t, (c_bk, ex_lb, bks)) = 
      (t::c_bk, ex_lb, bks)

  fun bd_bk mirlist =
      let val mirlist' = List.rev(mirlist)
	  val (c_bk, ex_lb, bks) = List.foldl bd_bk' ([], "", []) mirlist'
	  val n_bk = M_BK("", ex_lb, c_bk)
      in n_bk::bks
      end

  fun fd_bk bklb bks = 
      let fun fd (M_BK(ilb, olb, mirs)::r) = 
	      if bklb = ilb 
	      then (SOME(M_BK(ilb, olb, mirs)), r)
	      else (let val (res1, res2) = fd(r)  
		    in (res1, M_BK(ilb, olb, mirs)::res2)
		    end
		   )
	    | fd [] = (NONE, [])
      in fd bks
      end

  fun reog_bks mbks = 
      let fun reog lb bks ord_bks = 
	      let val (res1, res2) = fd_bk lb bks
	      in case res1
		  of NONE => 
		     (List.rev(ord_bks) @ (reog_bks res2))
		   | SOME(M_BK(lb1, lb2, mirs)) => 
		     let val n_ord_bks = M_BK(lb1, lb2, mirs)::ord_bks
		     in reog lb2 res2 n_ord_bks
		     end
	      end
	  fun get_hd (M_BK(lb1, lb2, mirs)::r) = SOME(lb1)
	    | get_hd [] = NONE
      in case (get_hd mbks)
	  of NONE => []
	   | SOME(n_lb) => reog n_lb mbks []
      end
  
  fun cvt_mirs mbks = 
      let fun cvt (M_BK(lb1, lb2, mirs)) = mirs
      in List.concat(List.map cvt mbks)
      end

  fun aux_top mirlist = 
      let val bks = bd_bk mirlist
	  val bks' = reog_bks bks
      in cvt_mirs bks'
      end 

end 
